module Main where
import System.Environment
import System.IO
import System.Console.GetOpt
import Common
import BfParse
import Interpret
import Optim
import Emit

data OptFlag = HelpFlag | TreeFlag | OptLevel String | OutFile String | InterpFlag
  deriving (Show, Eq, Ord)

data ProgArgs = ProgArgs { aHelp :: Bool, aTree :: Bool, aOptLev :: Int, aOutFile :: Maybe FilePath, aInterp :: Bool } 
   deriving (Eq,Show)

emptyArgs = ProgArgs { aHelp = False, aTree = False, aOptLev = 5, aOutFile = Nothing, aInterp = False }

options :: [OptDescr OptFlag]
options = [Option ['h'] ["help"] (NoArg HelpFlag) "Show help",
           Option ['t'] ["tree"] (NoArg TreeFlag) "Show output as AST",
           Option ['O'] ["opt" ] (ReqArg OptLevel "LEVEL") "Optimization level LEVEL",
           Option ['I'] ["interp" ] (NoArg InterpFlag) "Run Interpreter",
           Option ['o'] ["out" ] (ReqArg OutFile "FILE") "Output file FILE"]

main :: IO ()
main = do args <- getArgs
          case (getOpt RequireOrder options args) of
            (vals, non, []) -> runWithArgs non (parseArgs vals) 
            ( _, _, errs ) -> hPutStrLn stderr $ unlines errs

parseArgs2 :: [OptFlag] -> (Bool, Bool, Maybe String, Int, Bool)
parseArgs2 = foldl optP (False,False,Nothing,0,False)
 where optP (h,_,out,op,int) TreeFlag     = (h,True,out,op,int) 
       optP (h,t,_,op,int)   (OutFile n)  = (h,t,Just n,op,int)
       optP (_,t,out,op,int) HelpFlag     = (True,t,out,op,int)
       optP (h,t,out,_,int)  (OptLevel n) = (h,t,out,read n,int)
       optP (h,t,out,op,_)  InterpFlag    = (h,t,out,op,True)

parseArgs :: [OptFlag] -> ProgArgs
parseArgs = foldl optP emptyArgs
 where optP args TreeFlag     = args { aTree = True }
       optP args (OutFile n)  = args { aOutFile = Just n }
       optP args HelpFlag     = args { aHelp = True }
       optP args (OptLevel n) = args { aOptLev = (read n) }
       optP args InterpFlag   = args { aInterp = True }

runWithArgs :: [String] -> ProgArgs -> IO ()
runWithArgs _ (ProgArgs { aHelp = True }) = putStrLn (usageInfo "HBF Compiler" options) 
runWithArgs non args =
   do txt <- if null non || non == ["-"] 
              then getContents
              else readFile (head non)
      stream <- case aOutFile args of
                 Just x  -> openFile x WriteMode
                 Nothing -> return stdout
      case runParse txt of
       Left err -> hPrint stderr err
       Right x -> do 
                   let opted = (getOptLevel (aOptLev args)) x
                   if (aInterp args) then (run opted)
                    else (hPutStrLn stream . outputFun) opted  >> hFlush stream
 where outputFun = if (aTree args) then unlines . map showOperation else make_c
